home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / NRPAS13 / REALFT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  2KB  |  56 lines
  1. PROCEDURE realft(VAR data: gldarray; n,isign: integer);
  2. (* Programs using routine REALFT must define the type
  3. TYPE
  4.    gldarray = ARRAY [1..2*n] OF real;
  5. where 2*n is the dimension of the input data array. When
  6. routine FOUR1 is used with REALFT, its data type 'gldarray'
  7. should be set as in this program. *)
  8. VAR
  9.    wr,wi,wpr,wpi,wtemp,theta: double;
  10.    i,i1,i2,i3,i4: integer;
  11.    c1,c2,h1r,h1i,h2r,h2i,wrs,wis: real;
  12. BEGIN
  13.    theta := 6.28318530717959/(2.0*n);
  14.    c1 := 0.5;
  15.    IF (isign = 1) THEN BEGIN
  16.       c2 := -0.5;
  17.       four1(data,n,1);
  18.    END ELSE BEGIN
  19.       c2 := 0.5;
  20.       theta := -theta;
  21.    END;
  22.    wpr := -2.0*sqr(sin(0.5*theta));
  23.    wpi := sin(theta);
  24.    wr := 1.0+wpr;
  25.    wi := wpi;
  26.    FOR i := 2 TO (n DIV 2)+1 DO BEGIN
  27.       i1 := i+i-1;
  28.       i2 := i1+1;
  29.       i3 := n+n+3-i2;
  30.       i4 := i3+1;
  31.       wrs := sngl(wr);
  32.       wis := sngl(wi);
  33.       h1r := c1*(data[i1]+data[i3]);
  34.       h1i := c1*(data[i2]-data[i4]);
  35.       h2r := -c2*(data[i2]+data[i4]);
  36.       h2i := c2*(data[i1]-data[i3]);
  37.       data[i1] := h1r+wrs*h2r-wis*h2i;
  38.       data[i2] := h1i+wrs*h2i+wis*h2r;
  39.       data[i3] := h1r-wrs*h2r+wis*h2i;
  40.       data[i4] := -h1i+wrs*h2i+wis*h2r;
  41.       wtemp := wr;
  42.       wr := wr*wpr-wi*wpi+wr;
  43.       wi := wi*wpr+wtemp*wpi+wi
  44.    END;
  45.    IF (isign = 1) THEN BEGIN
  46.       h1r := data[1];
  47.       data[1] := h1r+data[2];
  48.       data[2] := h1r-data[2]
  49.    END ELSE BEGIN
  50.       h1r := data[1];
  51.       data[1] := c1*(h1r+data[2]);
  52.       data[2] := c1*(h1r-data[2]);
  53.       four1(data,n,-1)
  54.    END
  55. END;
  56.